home *** CD-ROM | disk | FTP | other *** search
/ The World of Computer Software / The World of Computer Software.iso / tspa3155.zip / TSUNTK.TST < prev    next >
Text File  |  1992-08-25  |  2KB  |  66 lines
  1. (* This is a test program for the TSUNTH.TPU unit 23-Aug-92 *)
  2.  
  3. uses TSUNTK;
  4.  
  5. procedure LOGO;
  6. begin
  7.   writeln;
  8.   writeln ('TSUNTK unit test by Prof. Timo Salmi, 23-Aug-92');
  9.   writeln ('University of Vaasa, Finland, ts@uwasa.fi');
  10.   writeln;
  11. end;  (* logo *)
  12.  
  13. (* Display the boot drive *)
  14. procedure TEST1;
  15. begin
  16.    writeln ('The boot drive was ', BOOTDRFN);
  17.    Flush (output);
  18. end;  (* test1 *)
  19.  
  20. (* Return the serial number of a disk *)
  21. procedure TEST2;
  22. var serial : string;
  23.     drive  : char;
  24.     path   : string;
  25. begin
  26.   drive := 'A';
  27.   serial := GETSERFN (drive);
  28.   writeln ('The serial number for ', UpCase(drive), ' is ', serial);
  29. end;  (* test2 *)
  30.  
  31. (* Get the volume label of a MsDos 4.+ disk *)
  32. procedure TEST3;
  33. var volume : string;
  34.     drive  : char;
  35. begin
  36.   drive := 'A';
  37.   volume := GETVOLFN (drive);
  38.   writeln ('The volume label for ', UpCase(drive), ' is ', volume);
  39. end;  (* test3 *)
  40.  
  41. (* Set the serial number of a floppy *)
  42. procedure TEST4;
  43. var serial : string;
  44.     drive  : char;
  45.     path   : string;
  46.     status : integer;
  47. begin
  48.   drive := 'A';
  49.   SETSER (drive, '1FAC-2B4D', status);
  50.   case status of
  51.     -1 : writeln ('Procedure not supported for MsDos versions prior 4.0');
  52.     -2 : writeln ('Unacceptable drive chosen');
  53.     -3 : writeln ('Error in the serial string XXXX-XXXX');
  54.     -4 : writeln ('An error was reported by the MsDos interrupt');
  55.   end; {case}
  56. end;  (* test4 *)
  57.  
  58. (* Main program *)
  59. begin
  60.   LOGO;
  61.   TEST1;
  62.   TEST2;
  63.   {}
  64.   write ('Press <-'' '); readln;
  65. end.  (* tsuntz.tst *)
  66.